home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / editpas.zip / EDIT.PAS
Pascal/Delphi Source File  |  1986-03-09  |  10KB  |  268 lines
  1. { EDIT.PAS
  2.   Version 2.0
  3.   Written by Bela Lubkin, 12/6/84
  4.   Last revised 12/22/85
  5.  
  6.   This is a set of three routines that can be used in a Turbo Pascal program
  7.   for getting input from the keyboard.  Each routine provides WordStar-like
  8.   single line editing of the input, an undo function, pre-setting of the input
  9.   buffer and filtering for allowable characters and maximum string length.
  10.  
  11.   Function AskString(Prompt,Param: String255; LegalChars: CharSet;
  12.                      MaxLen: Byte): String255;
  13.     -- prints the prompt string Prompt, then reads a string of length up to
  14.        MaxLen, composed of characters in the set LegalChars.  The string is
  15.        initially filled with the contents of Param.  If the global variable
  16.        ShowBuffer is true, editing starts with the passed in value displayed,
  17.        the cursor at the end; else it starts immediately following the prompt.
  18.        The terminating character is returned in global variable AskTerminator.
  19.        Other global parameters: AskNoisy, if true, sounds a bell if an attempt
  20.        is made to insert a character beyond MaxLen.  TermChars is a Set Of Char
  21.        that lists all the allowable terminator characters.  WordChars is a Set
  22.        Of Char that lists which characters are considered part of a word.
  23.  
  24.   Function AskInt(Prompt: String255; Param: Integer; MaxLen: Byte): Integer;
  25.     -- prints the prompt string Prompt, then reads a string of length up to
  26.        MaxLen, composed of characters legal for an integer.  The string is
  27.        then converted to an integer and returned as the function result.  The
  28.        initial edit buffer is filled with the ASCII representation of Param.
  29.        Everything else from AskString above applies.
  30.  
  31.   Function AskReal(Prompt: String255; Param: Real; MaxLen: Byte): Real;
  32.     -- prints the prompt string Prompt, then reads a string of length up to
  33.        MaxLen, composed of characters legal for a real.  The string is then
  34.        converted to a real and returned as the function result.  The initial
  35.        edit buffer is filled with the ASCII representation of Param.
  36.        Everything else from AskString above applies.
  37.  
  38.   Here is a list of the control characters used (including synonymous IBM PC
  39.   function keys):
  40.  
  41.   ^A   Move back 1 word, nondestructive                       [Ctrl-LeftArrow]
  42.   ^B   Save current buffer in undo buffer
  43.   ^C   End of input; accept what is currently visible             [Ctrl-Break]
  44.   ^D   Move forward one                                           [RightArrow]
  45.   ^F   Move forward 1 word                                   [Ctrl-RightArrow]
  46.   ^G   Delete character forward                                          [DEL]
  47.   ^H   Move back 1, destructive (same as ASCII DEL)                [BackSpace]
  48.   ^J   End of input; accept entire buffer                         [Ctrl-Enter]
  49.   ^L   Look for char: reads a character, advances cursor to match
  50.   ^M   End of input; accept what is currently visible                  [Enter]
  51.   ^N   End of input; accept entire buffer
  52.   ^P   Accept next character as-is (control character prefix)
  53.   ^Q   Move to beginning of line, nondestructive                        [Home]
  54.   ^R   Move to end of line                                               [End]
  55.   ^S   Move back 1, nondestructive                                 [LeftArrow]
  56.   ^T   Delete line forward                                          [Ctrl-End]
  57.   ^U   Copy undo buffer into current buffer (undo)
  58.   ^V   Insert on/off                                                     [INS]
  59.   ^X   Move to beginning of line, destructive                      [Ctrl-Home]
  60.   ^Y   Delete line
  61.   DEL  Move back 1, destructive (same as ^H) (ASCII DEL)      [Ctrl-BackSpace]
  62.   ESC  End of input; accept what is currently visible
  63.  
  64.   The initial contents of both the current buffer and the undo buffer are set
  65.   by the parameter Param.
  66.  
  67.   These routines will work with any version of Turbo Pascal.
  68. }
  69.  
  70. Type
  71.   CharSet=Set Of Char;
  72.   String255=String[255];
  73.  
  74. Const
  75.   TermChars: CharSet=[^C,^J,^M,^N,^[];               { Terminator characters }
  76.   WordChars: CharSet=['0'..'9','A'..'Z','a'..'z']; { Legal chars in a 'word' }
  77.   AskNoisy: Boolean=False;           { Ring bell on insert with buffer full? }
  78.   ShowBuffer: Boolean=False;       { Display incoming input buffer at start? }
  79.  
  80. Var
  81.   AskTerminator: Char;  { Output: the terminator used -- ^C, ^J, ^M, ^N, ESC }
  82.  
  83. Function AskString(Prompt,Param: String255; LegalChars: CharSet;
  84.                    MaxLen: Byte): String255;
  85.   Const
  86.     ESC=^[;
  87.     DEL=#$7F;
  88.     InsertFlag: Boolean=True;
  89.  
  90.   Var
  91.     AS: String255;
  92.     Cursor: Integer;
  93.     Ch,Ch2: Char;
  94.     WasChar,First: Boolean;
  95.  
  96.   Function CanPut: Boolean;
  97.     Begin
  98.       CanPut:=(Length(AS)>Cursor) And (Cursor<MaxLen);
  99.     End;
  100.  
  101.   Procedure PutC;
  102.     Var
  103.       C: Char;
  104.     Begin
  105.       Cursor:=Succ(Cursor);
  106.       C:=AS[Cursor];
  107.       If C<' ' Then Write('^',Chr(Ord(C)+64))
  108.       Else Write(C);
  109.     End; { PutC }
  110.  
  111.   Procedure UnPutC;
  112.     Begin
  113.       Write(^H' '^H);
  114.       If AS[Cursor]<' ' Then Write(^H' '^H);
  115.       Cursor:=Pred(Cursor);
  116.     End; { UnPutC }
  117.  
  118.   Begin { AskString }
  119.     Write(Prompt);
  120.     AS:=Param;
  121.     Cursor:=0;
  122.     First:=True;
  123.     Repeat
  124.       If First And ShowBuffer Then
  125.        Begin
  126.         First:=False;
  127.         Ch:=^R;
  128.        End
  129.       Else Read(Kbd,Ch);
  130.       WasChar:=False;
  131.       If (Ch=ESC) And KeyPressed Then
  132.        Begin
  133.         Read(Kbd,Ch);
  134.         Case Ch Of
  135.           's': Ch:=^A; { Ctrl-LeftArrow }
  136.           'M': Ch:=^D; { RightArrow }
  137.           't': Ch:=^F; { Ctrl-RightArrow }
  138.           'S': Ch:=^G; { DEL }
  139.           'G': Ch:=^Q; { Home }
  140.           'O': Ch:=^R; { End }
  141.           'K': Ch:=^S; { LeftArrow }
  142.           'u': Ch:=^T; { Ctrl-End }
  143.           'R': Ch:=^V; { INS }
  144.           'w': Ch:=^X; { Ctrl-Home }
  145.           Else Ch:='?';{ all unknowns }
  146.                WasChar:=True;
  147.          End;
  148.        End;
  149.       Case Ch Of
  150.         ^Q,^U,^X,^Y: Begin
  151.                        While Cursor>0 Do
  152.                         Begin
  153.                          UnPutC;
  154.                          If Ch=^X Then Delete(AS,Succ(Cursor),1);
  155.                         End;
  156.                        If Ch=^U Then AS:=Param
  157.                        Else If Ch=^Y Then AS:='';
  158.                      End;
  159.         ^A: Begin
  160.               While (Cursor>0) And Not (AS[Cursor] In WordChars) Do UnPutC;
  161.               If Cursor>0 Then UnPutC;
  162.               While (Cursor>0) And (AS[Cursor] In WordChars) Do UnPutC;
  163.             End;
  164.         ^B: Param:=AS;
  165.         ^D: If CanPut Then PutC;
  166.         ^F: Begin
  167.               If CanPut Then PutC;
  168.               While CanPut And (AS[Succ(Cursor)] In WordChars) Do PutC;
  169.               While CanPut And Not (AS[Succ(Cursor)] In WordChars) Do PutC;
  170.             End;
  171.         ^L: Begin
  172.               Read(Kbd,Ch);
  173.               If CanPut Then PutC;
  174.               While CanPut And (AS[Succ(Cursor)]<>Ch) Do PutC;
  175.               Ch:=^L;
  176.             End;
  177.         ^R,^N,^J: While CanPut Do PutC;
  178.         ^G: Delete(AS,Succ(Cursor),1);
  179.         ^H,^S,DEL: If Cursor>0 Then
  180.                     Begin
  181.                      UnPutC;
  182.                      If Ch<>^S Then Delete(AS,Succ(Cursor),1);
  183.                     End;
  184.         ^P: Begin
  185.               Read(Kbd,Ch);
  186.               WasChar:=True;
  187.             End;
  188.         ^T: Delete(AS,Succ(Cursor),Length(AS));
  189.         ^V: InsertFlag:=Not InsertFlag;
  190.         { Case } Else WasChar:=Not (Ch In TermChars);
  191.        End;
  192.       If WasChar And (Cursor<MaxLen) And (Ch In LegalChars) Then
  193.        Begin
  194.         If InsertFlag Then Insert(Ch,AS,Succ(Cursor))
  195.         Else AS[Succ(Cursor)]:=Ch;
  196.         If Succ(Cursor)>Length(AS) Then AS[0]:=Chr(Succ(Cursor));
  197.         PutC;
  198.        End
  199.       Else If AskNoisy And WasChar Then Write(^G);  { Ring bell, if AskNoisy }
  200.      Until (Ch In TermChars) And Not WasChar;
  201.     AskTerminator:=Ch;
  202.     AskString:=Copy(AS,1,Cursor);
  203.   End; { AskString }
  204.  
  205. Function AskInt(Prompt: String255; Param: Integer; MaxLen: Byte): Integer;
  206.   Var
  207.     Temp: String255;
  208.     P,I: Integer;
  209.   Begin
  210.     Str(Param,Temp);
  211.     Temp:=AskString(Prompt,Temp, ['0'..'9', '-'], MaxLen);
  212.     Val(Temp,P,I);
  213.     If Length(Temp)=0 Then AskInt:=0
  214.     Else If I=0 Then AskInt:=P
  215.     Else AskInt:=Param;
  216.   End; { AskInt }
  217.  
  218. Function AskReal(Prompt: String255; Param: Real; MaxLen: Byte): Real;
  219.   Var
  220.     Temp: String255;
  221.     P: Real;
  222.     I: Integer;
  223.   Begin
  224.     Str(Param:1:12,Temp);
  225.     I:=14;
  226.     While Temp[I]='0' Do I:=Pred(I);
  227.     If Temp[I]='.' Then I:=Pred(I);
  228.     Temp:=AskString(Prompt,Copy(Temp,1,I),['0'..'9', '.', '-'], MaxLen);
  229.     Val(Temp,P,I);
  230.     If Length(Temp)=0 Then AskReal:=0.0
  231.     Else If I=0 Then AskReal:=P
  232.     Else AskReal:=Param;
  233.   End; { AskReal }
  234.  
  235. (* A program to test the routines... close this comment to enable it.  For
  236.    best results, turn control-C checking off by putting {$C-} at the top of
  237.    the source code.
  238.  
  239. Var
  240.   X: String[40];
  241.   Y: Integer;
  242.   Z: Real;
  243.  
  244. Begin
  245.   ShowBuffer:=True;
  246.   X:='This is a test.';
  247.   Repeat
  248.     X:=AskString('Edit the buffer: ',X,[#0..#255],40);
  249.     WriteLn;
  250.     WriteLn(X);
  251.   Until X='';
  252.   Y:=100;
  253.   ShowBuffer:=False;
  254.   Repeat
  255.     Y:=AskInt('Edit the integer: ',Y,10);
  256.     WriteLn;
  257.     WriteLn(Y);
  258.   Until Y=0;
  259.   Z:=Pi;
  260.   ShowBuffer:=True;
  261.   Repeat
  262.     Z:=AskReal('Edit the real: ',Z,24);
  263.     WriteLn;
  264.     WriteLn(Z:1:11);
  265.   Until Z=0.0;
  266. End.
  267. (**)
  268.